home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / divers / memfree.e < prev    next >
Text File  |  1994-05-02  |  14KB  |  420 lines
  1. /* MemFree inspriré de gadtoolsdemo.e et avail.e */
  2. /*************************************************/
  3. /* V0.0a - Version initiale             */
  4. /* V0.0b - Ajout de Delay et Pubscreen         */
  5. /* v0.0c - Ajout de Front             */
  6. /* v0.0d - Ajout d'un port Arexx                 */
  7. /*       Commandes Arexx:             */
  8. /*       - QUIT/BACK/FRONT/NOFRONT/YESFRONT/     */
  9. /*         FAST/CHIP/CHANGEPS <nompubscreen>/  */
  10. /*         NEWDELAY <delay>/FASTCHIP/ZIP     */
  11. /* v0.0e - Ajout de menus et utilisation de la     */
  12. /*       reqtools.library.             */
  13. /*************************************************/
  14.  
  15. ENUM NONE,ER_OPENLIB,ER_WB,ER_VISUAL,ER_CONTEXT,ER_GADGET,ER_WINDOW,ER_MENUS,
  16.      ER_BADARGS,ER_REXXPORT,ER_SIG
  17. ENUM ARG_DELAY,ARG_PS,ARG_FRONT,NUMARGS
  18.  
  19. MODULE 'intuition/intuition', 'gadtools', 'libraries/gadtools',
  20.        'intuition/gadgetclass', 'exec/nodes', 'intuition/screens'
  21. MODULE 'exec/execbase','exec/lists','workbench/startup',
  22.        'exec/libraries','exec/tasks', 'exec/ports',
  23.        'intuition/intuitionbase'
  24. MODULE 'icon','wb','workbench/workbench'
  25. MODULE 'rexxsyslib','rexx/storage'
  26. MODULE 'reqtools','libraries/reqtools','utility/tagitem'
  27.  
  28. MODULE 'exec/execbase'
  29. MODULE 'graphics/text'
  30.  
  31.  
  32. ENUM CHIP,FAST
  33.  
  34. CONST GFXOFFSET=40, BUFSIZE=GADGETSIZE*5
  35.  
  36. DEF scr=NIL:PTR TO screen,
  37.     visual=NIL,
  38.     wnd=NIL:PTR TO window,
  39.     wndmp:PTR TO mp,
  40.     glist=NIL,offy,g,
  41.     type,infos,menu,gad,def_gad
  42.  
  43. DEF base:PTR TO execbase,x:PTR TO LONG
  44.  
  45. DEF rdargs=NIL
  46. DEF wb:PTR TO wbstartup,wb_args:PTR TO wbarg
  47. DEF pubscreen[256]:STRING,delay,screen[256]:STRING
  48. DEF struc_diskobj:PTR TO diskobject,nom_prg[50]:STRING
  49. DEF version[50]:STRING,front
  50. DEF myport:PTR TO mp,data_port:PTR TO ln,test_port
  51. DEF zipped=FALSE,zip_piv
  52. DEF tattr
  53. PROC main()
  54.   DEF cli_args[NUMARGS]:LIST,templ,x,r_quit
  55.   DEF sig
  56.   StrCopy(version,'$VER:\e[;32mMemFree\e[;0m v0.0e \e[;32m(\e[;33mc\e[;32m) Na\e[;33msG\e[;0mûl (10-Nov-93).',ALL)
  57.   base:=execbase  /* For Virus D */
  58.   IF (sig:=AllocSignal(-1))=NIL THEN checkerror(ER_SIG)
  59.   IF wbmessage=NIL
  60.       FOR x:=0 TO NUMARGS-1 DO cli_args[x]:=0
  61.       templ:='D=DELAY,PS/K,FRONT/S'
  62.       rdargs:=ReadArgs(templ,cli_args,NIL)
  63.       IF rdargs=NIL THEN checkerror(ER_BADARGS)
  64.       delay:=Val(cli_args[ARG_DELAY],NIL)
  65.       IF delay=0 THEN delay:=10
  66.       front:=cli_args[ARG_FRONT]
  67.       IF cli_args[ARG_PS]
  68.       StrCopy(pubscreen,cli_args[ARG_PS],ALL)
  69.       ELSE
  70.       StrCopy(pubscreen,'Workbench',ALL)
  71.       ENDIF
  72.   ELSE
  73.       IF (iconbase:=OpenLibrary('icon.library',37))=NIL THEN RETURN ER_OPENLIB
  74.       wb:=wbmessage
  75.       wb_args:=wb.arglist
  76.       CurrentDir(wb_args[0].lock)
  77.       StrCopy(nom_prg,wb_args[0].name,ALL)
  78.       struc_diskobj:=GetDiskObject(wb_args[0].name)
  79.       delay:=Val(FindToolType(struc_diskobj.tooltypes,'DELAY'),NIL)
  80.       IF delay=0 THEN delay:=10
  81.       screen:=FindToolType(struc_diskobj.tooltypes,'PS')
  82.       IF screen=0
  83.       StrCopy(pubscreen,'Workbench',ALL)
  84.       ELSE
  85.       StrCopy(pubscreen,screen,ALL)
  86.       ENDIF
  87.       front:=FindToolType(struc_diskobj.tooltypes,'FRONT')
  88.       IF StrCmp(front,'TRUE',ALL)
  89.       front:=TRUE
  90.       ELSE
  91.       front:=FALSE
  92.       ENDIF
  93.   ENDIF
  94.   checkerror(initinterface())
  95.   checkerror(openinterface())
  96.   REPEAT
  97.     wait4message()
  98.     IF type=IDCMP_CLOSEWINDOW
  99.     r_quit:=RtEZRequestA('      (c) 1993 By NasGûl\n      ~~~~~~~~~~~~~~~~~~\nVoulez-vous vraiment Quitter ?','Oui|Non',0,0,[RT_PUBSCRNAME,pubscreen,RTEZ_REQTITLE,'MemFree v0.0e',TAG_DONE]:tagitem)
  100.     IF r_quit=1 THEN type:=IDCMP_CLOSEWINDOW ELSE type:=0
  101.     ENDIF
  102.   UNTIL type=IDCMP_CLOSEWINDOW
  103.   closeinterface()
  104. ENDPROC
  105. PROC initinterface()
  106.   DEF menu_toggle
  107.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ER_OPENLIB
  108.   IF (intuitionbase:=OpenLibrary('intuition.library',37))=NIL THEN RETURN ER_OPENLIB
  109.   IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))=NIL THEN RETURN ER_OPENLIB
  110.   IF (test_port:=FindPort('MemFreePort'))<>0 THEN RETURN ER_REXXPORT
  111.   IF myport:=CreateMsgPort()
  112.     data_port:=myport.ln
  113.     data_port.name:='MemFreePort'
  114.     AddPort(myport)
  115.   ENDIF
  116.   IF front=TRUE
  117.       menu_toggle:=$109
  118.   ELSE
  119.       menu_toggle:=$9
  120.   ENDIF
  121.   IF (menu:=CreateMenusA([1,0,' Options ',0,0,0,0,
  122.               2,0,'  NewDelay','N',0,0,0,
  123.               2,0,'  ChangePs','P',0,0,0,
  124.               2,0,'  Quitter ','Q',0,0,0,
  125.               1,0,' Mémoire  ',0,0,0,0,
  126.               2,0,'  Fast    ','F',0,0,0,
  127.               2,0,'  Chip    ','C',0,0,0,
  128.               2,0,' Fast/Chip','V',0,0,0,
  129.               2,0,' Virus D  ','D',0,0,0,
  130.               1,0,'  Fenêtre ',0,0,0,0,
  131.               2,0,'  YesFront','T',menu_toggle,0,0,
  132.               0,0,0,0,0,0,0]:newmenu,NIL))=NIL THEN RETURN ER_MENUS
  133. ENDPROC
  134. PROC openinterface()
  135.   DEF rast
  136.   tattr:=['topaz.font',8,0,0]:textattr
  137.   gad:='CHIP'
  138.   def_gad:=gad
  139.   IF (scr:=LockPubScreen(pubscreen))=NIL
  140.       RtEZRequestA('Ecran public introuvable.','Ok',0,0,[RT_PUBSCRNAME,pubscreen,RTEZ_REQTITLE,'MemFree v0.0e',TAG_DONE]:tagitem)
  141.       IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN ER_WB
  142.   ENDIF
  143.   ScreenToFront(scr)
  144.   IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN ER_VISUAL
  145.   offy:=scr.wbortop+Int(scr.rastport+58)+1
  146.   IF (g:=CreateContext({glist}))=NIL THEN RETURN ER_CONTEXT
  147.   IF LayoutMenusA(menu,visual,NIL)=FALSE THEN RETURN ER_MENUS
  148.   IF (g:=CreateGadgetA(BUTTON_KIND,g,[scr.wborleft+6,offy+31,80,
  149.                      11,'   Chip   ',tattr,1,PLACETEXT_IN,visual,'CHIP']:newgadget,
  150.                     [GTSC_TOP,2,GTSC_VISIBLE,3,
  151.                      GTSC_TOTAL,10,GTSC_ARROWS,22,
  152.                      PGA_FREEDOM,LORIENT_HORIZ,GA_RELVERIFY,
  153.                      GTLV_SELECTED,
  154.                      TRUE,GA_IMMEDIATE,TRUE,0]))=NIL THEN RETURN ER_GADGET
  155.   IF (g:=CreateGadgetA(BUTTON_KIND,g,[scr.wborleft+87,offy+31,80,
  156.                      11,'   Fast   ',tattr,1,PLACETEXT_IN,visual,'FAST']:newgadget,
  157.                      [GTSC_TOP,2,GTSC_VISIBLE,3,
  158.                      GTSC_TOTAL,10,GTSC_ARROWS,22,
  159.                      PGA_FREEDOM,LORIENT_HORIZ,GA_RELVERIFY,
  160.                      GTLV_SELECTED,
  161.                      TRUE,GA_IMMEDIATE,TRUE,0]))=NIL THEN RETURN ER_GADGET
  162.   /*IF (wnd:=OpenW(scr.width-182,scr.height-46-offy,182,offy+46,$30C OR SCROOLERIDCMP,8+2+$1000,'MemFree v0.0e',scr,2,glist))=NIL THEN RETURN ER_WINDOW*/
  163.   IF (wnd:=OpenW(scr.width-182,scr.height-46-offy,182,offy+46,$40032C+BUTTONIDCMP,$100A,'MemFree v0.0e',scr,2,glist))=NIL THEN RETURN ER_WINDOW
  164.   wnd.screentitle:='MemFree v0.0e (c) 1993 NasGûl'
  165.   wndmp:=wnd.userport
  166.   rast:=wnd.rport
  167.   SetTopaz(8)
  168.   IF SetMenuStrip(wnd,menu)=FALSE THEN RETURN ER_MENUS
  169.   Gt_RefreshWindow(wnd,NIL)
  170.   display(gad)
  171. ENDPROC
  172.  
  173. PROC closeinterface()
  174.   IF wnd THEN ClearMenuStrip(wnd)
  175.   IF menu THEN FreeMenus(menu)
  176.   IF visual THEN FreeVisualInfo(visual)
  177.   IF wnd THEN CloseWindow(wnd)
  178.   IF glist THEN FreeGadgets(glist)
  179.   IF scr THEN UnlockPubScreen(NIL,scr)
  180.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  181.   IF intuitionbase THEN CloseLibrary(intuitionbase)
  182.   IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  183.   IF rdargs THEN FreeArgs(rdargs)
  184.   IF iconbase THEN CloseLibrary(iconbase)
  185.   IF struc_diskobj THEN FreeDiskObject(struc_diskobj)
  186.   IF myport THEN RemPort(myport)
  187.   IF myport THEN DeleteMsgPort(myport)
  188. ENDPROC
  189.  
  190. PROC close_win()
  191.   IF wnd THEN ClearMenuStrip(wnd)
  192.   IF visual THEN FreeVisualInfo(visual)
  193.   IF wnd THEN CloseWindow(wnd)
  194.   IF glist THEN FreeGadgets(glist)
  195.   IF scr THEN UnlockPubScreen(NIL,scr)
  196. ENDPROC
  197.  
  198. PROC checkerror(er)
  199.   DEF errors:PTR TO LONG
  200.   IF er>0
  201.     closeinterface()
  202.     errors:=['','Impossible d\aouvrir la\n "gadtools.library" v37',
  203.         'Ecran public introuvable',
  204.         'Erreur: visual infos',
  205.         'Erreur: creation context',
  206.         'Erreur: creation gadget',
  207.         'Erreur : Ouverture fenêtre',
  208.         'Erreur: allocation menus',
  209.         'Erreur : Bad Args !',
  210.         'Port Arexx existant',
  211.         'Erreur : Allocation Signal']
  212.     RtEZRequestA(errors[er],'Ok',0,0,[RT_PUBSCRNAME,pubscreen,RTEZ_REQTITLE,'MemFree v0.0e',TAG_DONE]:tagitem)
  213.     CleanUp(10)
  214.   ENDIF
  215. ENDPROC
  216.  
  217. PROC wait4message()
  218.   DEF mes:PTR TO intuimessage,g:PTR TO gadget
  219.   DEF appmsg:PTR TO rexxmsg,com_rexx[50]:STRING
  220.   DEF rexx_args:PTR TO LONG,change_aff,change_id
  221.   DEF retour,val,str[80]:STRING
  222.   DEF req:PTR TO rtfilerequester,ch_pubsc=FALSE
  223.   DEF virus_action=0,item_adr:PTR TO menuitem
  224.   REPEAT
  225.     type:=0
  226.     IF mes:=Gt_GetIMsg(wnd.userport)
  227.     type:=mes.class
  228.     IF type=IDCMP_MENUPICK
  229.       infos:=mes.code
  230.       SELECT infos
  231.           CASE $F800             /* GET NEW DELAY */
  232.           IF req:=RtAllocRequestA(RT_REQINFO,NIL)
  233.               val:=delay
  234.               retour:=RtGetLongA({val},'MemFree v0.0e',NIL,
  235.                      [RT_PUBSCRNAME,pubscreen,
  236.                       RTGL_MIN,10,
  237.                       RTGL_MAX,3000,
  238.                       RTGL_TEXTFMT,'Nouveau Delay',
  239.                       RTGL_GADFMT,'New|Cancel',
  240.                       TAG_DONE]:tagitem)
  241.               IF retour=1 THEN delay:=val
  242.               RtFreeRequest(req)
  243.           ENDIF
  244.           CASE $F820             /* GET NEW PUBSCREEN */
  245.           IF req:=RtAllocRequestA(RT_REQINFO,NIL)
  246.               retour:=RtGetStringA(str, 200,'MemFree v0.0e',NIL,
  247.                            [RT_PUBSCRNAME,pubscreen,
  248.                         RTGS_GADFMT,'Ok|Cancel',
  249.                         RTGS_TEXTFMT, 'Choix d\aun nouveau Public screen.',
  250.                         TAG_DONE]:tagitem)
  251.               IF retour=1
  252.               ch_pubsc:=TRUE
  253.               StrCopy(pubscreen,str,ALL)
  254.               ENDIF
  255.               RtFreeRequest(req)
  256.           ENDIF
  257.           CASE $F840             /* QUITTER */
  258.           type:=IDCMP_CLOSEWINDOW
  259.           /******************************/
  260.           CASE $F801             /* MEM FAST */
  261.           def_gad:='FAST'
  262.           change_aff:=FALSE
  263.           CASE $F821             /* MEM CHIP */
  264.           def_gad:='CHIP'
  265.           change_aff:=FALSE
  266.           CASE $F841             /* FASTCHIP */
  267.           change_aff:=TRUE
  268.           CASE $F861             /* Virus D  */
  269.          IF check_exec() THEN virus_action:=RtEZRequestA('Virus Détected.','ColdReboot|Gasp !!',0,0,[RT_PUBSCRNAME,pubscreen,RTEZ_REQTITLE,'MemFree v0.0e',TAG_DONE]:tagitem)
  270.          IF virus_action=1 THEN ColdReboot()
  271.           /******************************/
  272.           CASE $F802             /* Always Front */
  273.           IF front=TRUE
  274.               front:=FALSE
  275.           ELSE
  276.               front:=TRUE
  277.           ENDIF
  278.           DEFAULT;      NOP
  279.       ENDSELECT
  280.     ELSEIF (type=IDCMP_GADGETDOWN) OR (type=IDCMP_GADGETUP)
  281.         g:=mes.iaddress
  282.         infos:=g.gadgetid
  283.         gad:=g.userdata
  284.         def_gad:=gad
  285.         display(gad)
  286.         change_aff:=FALSE
  287.     ELSEIF type=IDCMP_REFRESHWINDOW
  288.       Gt_BeginRefresh(wnd)
  289.       Gt_EndRefresh(wnd,TRUE)
  290.       type:=0
  291.     ELSEIF type<>IDCMP_CLOSEWINDOW
  292.         type:=0
  293.     ENDIF
  294.     Gt_ReplyIMsg(mes)
  295.     IF ch_pubsc=TRUE
  296.         ch_pubsc:=FALSE
  297.         zipped:=FALSE
  298.         close_win()
  299.         checkerror(openinterface())
  300.     ENDIF
  301.     ELSE
  302.       IF appmsg:=GetMsg(myport)
  303.       rexx_args:=appmsg.args
  304.       StrCopy(com_rexx,rexx_args[0],ALL)
  305.       IF StrCmp(com_rexx,'QUIT',ALL)
  306.           type:=IDCMP_CLOSEWINDOW
  307.       ELSEIF StrCmp(com_rexx,'FRONT',ALL)
  308.           WindowToFront(wnd)
  309.       ELSEIF StrCmp(com_rexx,'BACK',ALL)
  310.           WindowToBack(wnd)
  311.       ELSEIF StrCmp(com_rexx,'CHIP',ALL)
  312.           change_aff:=FALSE
  313.           def_gad:='CHIP'
  314.           display(def_gad)
  315.       ELSEIF StrCmp(com_rexx,'FASTCHIP',ALL)
  316.           change_aff:=TRUE
  317.           change_id:=0
  318.       ELSEIF StrCmp(com_rexx,'FAST',ALL)
  319.           change_aff:=FALSE
  320.           def_gad:='FAST'
  321.           display(def_gad)
  322.       ELSEIF StrCmp(com_rexx,'NOFRONT',ALL)
  323.           item_adr:=ItemAddress(menu,$F802)
  324.           front:=FALSE
  325.           item_adr.flags:=$605F
  326.       ELSEIF StrCmp(com_rexx,'YESFRONT',ALL)
  327.           item_adr:=ItemAddress(menu,$F802)
  328.           front:=TRUE
  329.           item_adr.flags:=$615F
  330.       ELSEIF StrCmp(com_rexx,'CHANGEPS',8)
  331.           IF StrLen(com_rexx)=8
  332.           StrCopy(pubscreen,'Workbench',ALL)
  333.           ELSE
  334.           MidStr(pubscreen,com_rexx,9,ALL)
  335.           ENDIF
  336.           zipped:=FALSE
  337.           close_win()
  338.           checkerror(openinterface())
  339.       ELSEIF StrCmp(com_rexx,'NEWDELAY',8)
  340.           MidStr(delay,com_rexx,9,ALL)
  341.           delay:=Val(delay,NIL)
  342.           IF delay<10 THEN delay:=10
  343.       ELSEIF StrCmp(com_rexx,'ZIP',ALL)
  344.           IF zipped=FALSE
  345.           SizeWindow(wnd,0,-46)
  346.           MoveWindow(wnd,0,46)
  347.           zip_piv:=TRUE
  348.           ELSEIF zipped=TRUE
  349.           MoveWindow(wnd,0,-46)
  350.           SizeWindow(wnd,0,46)
  351.           zip_piv:=FALSE
  352.           ENDIF
  353.           zipped:=zip_piv
  354.       ELSEIF StrCmp(com_rexx,'VD',2)
  355.          IF check_exec() THEN RtEZRequestA('Virus Détected.','ColdReboot|Gasp !!',0,0,[RT_PUBSCRNAME,pubscreen,RTEZ_REQTITLE,'MemFree v0.0e',TAG_DONE]:tagitem)
  356.          IF virus_action=1 THEN ColdReboot()
  357.       ENDIF
  358.       ReplyMsg(appmsg)
  359.       ENDIF
  360.       WHILE appmsg:=GetMsg(myport) DO ReplyMsg(appmsg)
  361.       IF (change_aff=TRUE) AND (change_id=0)
  362.       def_gad:='FAST'
  363.       change_id:=-1
  364.       ELSEIF change_aff=TRUE
  365.       def_gad:='CHIP'
  366.       change_id:=0
  367.       ENDIF
  368.       IF front=TRUE
  369.       Forbid()
  370.       Gt_BeginRefresh(wnd)
  371.       WindowToFront(wnd)
  372.       Gt_EndRefresh(wnd,TRUE)
  373.       Permit()
  374.       ENDIF
  375.       display(def_gad)
  376.       /*Delay(delay)*/
  377.       Wait(Shl(1,wndmp.sigbit))
  378.     ENDIF
  379.   UNTIL type
  380. ENDPROC
  381. PROC display(gad)
  382.     DEF chip,fast,largest_chip,largest_fast
  383.     DEF total_chip,total_fast
  384.     chip:=AvailMem($2)
  385.     fast:=AvailMem($4)
  386.     largest_chip:=AvailMem($20002)
  387.     largest_fast:=AvailMem($20004)
  388.     total_chip:=AvailMem($80002)
  389.     total_fast:=AvailMem($80004)
  390.     IF StrCmp(gad,'CHIP',ALL)
  391.     TextF(10,10+offy,'  Chip  :\d[9]',chip)
  392.     TextF(10,10+offy+8,'  L Chip:\d[9]',largest_chip)
  393.     TextF(10,10+offy+16,'  T Chip:\d[9]',total_chip)
  394.     ELSEIF StrCmp(gad,'FAST',ALL)
  395.     TextF(10,10+offy,'  Fast  :\d[9]',fast)
  396.     TextF(10,10+offy+8,'  L Fast:\d[9]',largest_fast)
  397.     TextF(10,10+offy+16,'  T Fast:\d[9]',total_fast)
  398.     ENDIF
  399. ENDPROC
  400. /*******************************/
  401. /* Routines par EA van breemen */
  402. /*******************************/
  403. /* A small virus detector      */
  404. /* By EA van Breemen           */
  405. /*******************************/
  406. /* Check procedure of execbase */
  407. PROC check_exec()
  408.     DEF test
  409.     RtEZRequestA('  By EA van Breemen\n  ~~~~~~~~~~~~~~~~~\nColdCapture :\z\h[8]\nCoolCapture :\z\h[8]\nKickMemPtr  :\z\h[8]\nKickTagPtr  :\z\h[8]',
  410.         'Ok',
  411.            0,
  412.         [base.coldcapture,base.coolcapture,
  413.          base.kickmemptr,base.kicktagptr],
  414.         [RT_PUBSCRNAME,pubscreen,RTEZ_REQTITLE,'MemFree v0.0e',TAG_DONE]:tagitem)
  415. test:=Exists({x},[[base.coldcapture,'ColdCapture'],[base.coolcapture,'CoolCapture'],
  416.           [base.kickmemptr,'KickMemPtr'],[base.kicktagptr,'KickTagPtr']],
  417.           `x[0])
  418.  
  419. ENDPROC test
  420.